home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / PBLIB1 / PROGS / PUT.PAS < prev    next >
Pascal/Delphi Source File  |  1994-05-03  |  4KB  |  148 lines
  1. PROGRAM Put;
  2.  
  3. {$M 20000,0,50000}
  4.  
  5. Uses PbMISC, PbDATA, PbOBJS, PbHIGH, PbOUT0, PbPARMS;
  6.  
  7. {
  8. Description : Smart copydown to Floppy
  9.  
  10. Author      : Howard Richoux
  11. Date        : 12/18/93
  12. Last revised: 12/20/93 hnr changed HNR* to H*
  13.               12/25/93 1.02 PbOUT
  14.               1/12/94  1.03 cleanup
  15.               2/18/94  1.04 new libraries
  16. Application : IBM PC and compatibles, done in Turbo Pascal 7.0
  17. Status      : Placed in the Public Domain by HNR Software 1/29/1994
  18. Published in: none
  19.  
  20. Config Parameters        meaning              default
  21. FILES                    if no params         do HNR*.zip
  22. SOURCE                   if no params         c:\zip\
  23. DEST                     if no params         b:
  24. ZIPTEST                  do PKUNZIP -t <dest><files>
  25. }
  26.  
  27.  
  28.  
  29. var files  : string;
  30.     source : string;
  31.     dest   : string;
  32.     fileext : string[3];
  33.     ziptestflag : boolean;
  34.  
  35. var log      : STRA_object;
  36.  
  37. {*****************************************************************}
  38.  
  39.  
  40. Procedure CopyAndTestFile(source,fn,dest : string; testflag : boolean);
  41. var s : string;
  42.     err : integer;
  43.      begin
  44.      s := 'copy   '+addbackslash(source)+fn+' '+
  45.                   addbackslash(dest)+'*.*';
  46.      log.append(s);
  47.      writeln(s);
  48.      err := ExecuteCommand(s);
  49.      if err <> 0 then
  50.           begin
  51.           log.append('Copy   failed  err='+integerstr(err,4));
  52.           exit;
  53.           end;
  54.      if ziptestflag then
  55.           begin
  56.           s := 'pkunzip -T '+addbackslash(dest)+fn;
  57.           log.append(s);
  58.           writeln(s);
  59.           err := ExecuteCommand(s);
  60.           if err <> 0 then
  61.                begin
  62.                log.append('PKUNZIP -T  failed  err='+integerstr(err,4));
  63.                exit;
  64.                end;
  65.           end;
  66.      OUT(' ');
  67.      end;
  68.  
  69.  
  70. Procedure DumpLog(log : STRA_object);
  71. var i : integer;
  72.     begin
  73.     OUT(' ');
  74.     OUT('PUT - log of commands');
  75.     for i := 1 to log.count do
  76.          begin OUT(log.fetchN(i)); end;
  77.     log.done;
  78.     end;
  79.  
  80.  
  81. Procedure GoOn;
  82. var s,srcfn,dstfn : string;
  83.     flist : STRA_object;
  84.     i : integer;
  85.      begin
  86.      flist.init(200);
  87.      log.init(500);  { commands and errors }
  88.      log.append('Copying ['+files+']  from ['+source+']  to ['+dest+']');
  89.  
  90.      s := addbackslash(source)+files;
  91.      GetFilesSTRA(s,flist,fNoSort);
  92.      i := 1;
  93.      while i <= flist.count do
  94.           begin
  95.           srcfn := addbackslash(source)+flist.fetchN(i);
  96.           dstfn := addbackslash(dest)+flist.fetchN(i);
  97.           if not EquivalentFile(srcfn,dstfn) then
  98.                begin
  99.                CopyAndTestFile(source,flist.fetchN(i),dest,ziptestflag);
  100.                end
  101.           else begin
  102.                log.append('Skipping '+srcfn);
  103.                writeln('Skipping '+srcfn);
  104.                end;
  105.           inc(i);
  106.           end;
  107.      flist.done;
  108.      DumpLog(log);
  109.      end;
  110.  
  111.  
  112.  
  113. Procedure Init;
  114. var s : string;
  115.     begin
  116.     AddParm(1,'FILES','H*.ZIP');
  117.     AddParm(1,'EXT','ZIP');
  118.     AddParm(1,'SOURCE', 'C:\ZIP\');
  119.     AddParm(1,'DEST', 'B:');
  120.     AddParm(1,'ZIPTEST', 'YES');
  121.  
  122.     StandardOUTInit;
  123.  
  124.     files       := GetParmStr('FILES');
  125.     source      := GetParmStr('SOURCE');
  126.     dest        := GetParmStr('DEST');
  127.     fileext     := GetParmStr('EXT');
  128.     ziptestflag := CheckOK('ZIPTEST');
  129.     OUTSetNoPause;
  130.  
  131.     if paramcount >0 then
  132.          begin
  133.          files := paramstr(1);
  134.          ForceExt(files,fileext);
  135.          end;
  136.     end;
  137.  
  138.  
  139. (*  Main program *)
  140.      BEGIN
  141.      pProgID := 'Put 1.04';
  142.      Init;
  143.      GoOn;
  144.      OUTdone;
  145.      end.
  146.  
  147.  
  148.